perm filename XPOSE.SAI[PIX,HPM]1 blob sn#460773 filedate 1979-07-22 generic text, type T, neo UTF8
BEGIN "XPOSE"
comment transposes a moby picture file;
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE MAXW=230000;

   BEGIN
   INTEGER I,J,K, INF,OUF,NLN, BPS,BPD;
   INTEGER ARRAY IHD[0:10],OHD[0:10];

   DO PRINT("Input picture:") UNTIL (INF←OPNPFL(INCHWL,IHD[0]))>0;
   MAKDIM(IHD[LNBY],IHD[PCLN],IHD[BYBI],OHD[0]);
   PRSFIL("");
   DO PRINT("Output file:") UNTIL (OUF←CREPFL(OHD[0],INCHWL))≥0;
      BEGIN
      INTEGER ARRAY PERM[0:IHD[BMAX]];
      INTEGER ARRAY OLD,NEW[0:100];
      INTEGER NUMP,FOO; STRING INP;

      FOR I←1 STEP 1 UNTIL BMAX DO PERM[I]←I;
      PRINT(IHD[BMAX]," is maximum grey level",
	      " enter piecewise linear link points",'15&'12,
	      " old value , new value    end with a blank line",'15&'12);
      NUMP←0;
      WHILE LENGTH(INP←INCHWL)>0 DO
	 BEGIN
	 NUMP←NUMP+1;
	 OLD[NUMP]←REALSCAN(INP,FOO);
	 NEW[NUMP]←REALSCAN(INP,FOO);
	 IF OLD[NUMP]<0∨OLD[NUMP]>IHD[BMAX] THEN
	    BEGIN PRINT("rejected",'15&'12); NUMP←NUMP-1; END;
	 END;
      FOR I←1 STEP 1 UNTIL NUMP-1 DO
      FOR J←I+1 STEP 1 UNTIL NUMP DO
      IF OLD[I]>OLD[J] THEN BEGIN OLD[I]↔OLD[J]; NEW[I]↔NEW[J]; END;
      IF NUMP>0 THEN
	 BEGIN OLD[NUMP+1]←OLD[NUMP]; NEW[NUMP+1]←NEW[NUMP]; END;
      FOR I←1 STEP 1 UNTIL NUMP DO
	 BEGIN
	 FOR J←OLD[I] STEP 1 UNTIL OLD[I+1] DO
	    PERM[J]←(NEW[I+1]*(J-OLD[I])+NEW[I]*(OLD[I+1]-J+1))
		    %(OLD[I+1]+1-OLD[I]);
	 END;

      NLN←((MAXW-IHD[LNWD]) % OHD[LNWD]) MAX 1;

      PRINT((OHD[PCLN]-1)%NLN+1," sections",'15&'12);
      FOR I←0 STEP 1 UNTIL (OHD[PCLN]-1)%NLN DO
	 BEGIN
	 INTEGER ARRAY OLN[1:NLN,1:OHD[LNWD]], ILN[0:IHD[LNWD]];
	 PRINT(" ",I);
	 USETI(INF,2);  comment move to beginning of input file;
	 FOR J←1 STEP 1 UNTIL IHD[PCLN] DO
	    BEGIN
	    ARRYIN(INF,ILN[1],IHD[LNWD]); comment read in a scanline;
	    BPS←POINT(IHD[BYBI],ILN[1+(I*NLN-1)%IHD[WDBY]],
		     ((I*NLN-1) MOD IHD[WDBY])*IHD[BYBI]+IHD[BYBI]-1);
	    BPD←POINT(OHD[BYBI],OLN[1,1+(OHD[LNBY]-J)%OHD[WDBY]],
		     ((OHD[LNBY]-J) MOD OHD[WDBY])*OHD[BYBI]+OHD[BYBI]-1);
	    FOR K←I*NLN STEP 1 UNTIL (I*NLN+NLN-1) MIN (IHD[LNBY]-1) DO
	       BEGIN DPB(PERM[ILDB(BPS)],BPD); BPD←BPD+OHD[LNWD]; END;
	    END;
	 J←0;
	 PRINT(" writing ",I*NLN," thru ",(I*NLN+NLN-1) MIN (IHD[LNBY]-1),'15&'12);
	 FOR K←I*NLN STEP 1 UNTIL (I*NLN+NLN-1) MIN (IHD[LNBY]-1) DO
	    ARRYOUT(OUF,OLN[J←J+1,1],OHD[LNWD]);
	 END;
      RELEASE(OUF);
      RELEASE(INF);
      END;
   END;
END "XPOSE";